#lang racket

(require "utilities.scm")
(require "box.scm")
(require "counter.scm")
(require "sets.scm")
(require "syntax-object.scm")

(provide ss-env
	 ss-env-scope-counter
	 ss-env-current-scope-set
	 ss-env-binding-table
         ss-env-syntax-env

	 ss-lookup
	 ss-bind! gensym+ss-bind!

         identifier-equal?)

(struct ss-env ((scope-counter)
		(current-scope-set)
		(binding-table)
                (syntax-env))
	#:transparent)

;; The scope set environment is an important tool for implementing
;; a resolver and expander based on scope sets.
;;
;; It provides:
;; * a gensym counter for naming scopes
;; * the current scope set
;; * the binding table
;;
;; the binding table stores the mappings: name * set -> value
;; this is implemented as a hash table first mapping names to assoc lists
;; and the assoc lists are set -> value maps

(define (ss-bound? env name)
  ;; do we have any kind of bindings at all for the name given
  ;; (returns the submapping of sets -> values)
  (hash-ref (ss-env-binding-table env) name #f))

(define (ss-lookup name set env)
  (cond ((ss-bound? env name)
         => (lambda (entries)
	      (let loop ((best #f) (best-score #f) (entries entries))
		(if (null? entries)
		    (if best-score
			best
			(error "ss-lookup: Unbound variable [a]" name))
		    (let ((entry (car entries))
			  (entries (cdr entries)))
		      (if (set-subset? (car entry) set)
			  (let ((score (length (set-elements (car entry)))))
			    (if (or (not best-score) (> score best-score))
				(loop (cdr entry) score entries)
				(loop best best-score entries)))
			  (loop best best-score entries)))))))
	(else (error "ss-lookup: Unbound variable [b]" name))))

(define (ss-bind! env name set value)
  (let* ((table (ss-env-binding-table env))
	 (name-entries (hash-ref table name '())))
    (hash-set! table name (assoc-replace name-entries set value)))
  env)

(define (gensym+ss-bind! env sc var)
  ;; This is a common operation when resolving things like LAMBDA
  ;; or LET, that create a new scope and bind a bunch of variables
  ;; in it.
  ;;
  ;; It takes in the new scope being created as well as a variable
  ;; and it produces a fresh gensymmed name for that var, as well
  ;; as adding a binding mapping the variable - in the new scope -
  ;; to its new name.
  ;;
  (let* ((nm (syx-id var))
         (gen (syx 'id (gensym nm) (syx-metadata var)))
         (set (set-insert sc (syx-scope-set var))))
    (ss-bind! env nm set `(variable . ,gen))
    gen))

(define (identifier-equal? env e1 e2)
  ;; identifiers are considered equal when:
  ;; 
  ;; they have the same name AND (are both unbound OR or both bound to the same value)
  ;;
  (and (eq? (syx-id e1) (syx-id e2))
       (let ((e1-bound? (ss-bound? env e1)) (e2-bound? (ss-bound? env e2)))
       (or (and (not e1-bound?) (not e2-bound?))
           (and e1-bound? e2-bound?
                (equal? (ss-lookup (syx-id e1) (syx-scope-set e1) env)
                        (ss-lookup (syx-id e2) (syx-scope-set e2) env)))))))
